module Lexer(Token(..), fusionLexer, showTokens) where
  
import Char
import Data.List
import Support
import Enderize

data Token = TString String
           | TKeyword String | TSubKeyword String
           | TInt Int
           | TVar String
           | TAttr String
           | TStatic String
           | TGlobal String
           | TSymbol String
           | TOp String
           | TOpen Char | TClose Char
           | TConst String
           | TClass String
           | TPattern String
           | TVoid
           deriving Show

showToken :: Token -> String
showToken (TString t) = t
showToken (TClass t) = t
showToken (TConst t) = t
showToken (TKeyword t) = t
showToken (TSubKeyword t) = t
showToken (TAttr t) = '@' : t
showToken (TStatic t) = "@@" ++ t
showToken (TGlobal t) = '$' : t
showToken (TInt t) = show t
showToken (TVar t) = t
showToken (TPattern t) = "/" ++ t ++ "/"
showToken (TOp t) = t
showToken (TOpen t) = t:""
showToken (TClose t) = t:""
showToken TVoid = "VOID"

showTokens :: [Token] -> String
showTokens = intercalate " " . map showToken

mainKeywords  = ["abstract", "and", "begin", "case", "class", "def", "do", "extends", "for", "from", "function", "if", "implements", "import", "in", "interface", "module", "not", "or", "override", "procedure", "require", "return", "static", "struct", "unless", "until", "while", "with"]
subKeywords   = ["else", "elsif", "when"]

-- Operatori (devono essere ordinati dal più lungo al più corto)
operators = ["and", "not", ">>=", "<<=", "&&=", "||=", "**=", "...", "<=>", "===", "or", "%=", "~=", "/=", "-=", "+=", "|=", "&=", "*=", "..", "||", "&&", "==", "!=", "=~", "!~", "<=", "<<", ">>", "++", "--", "**", "=>", "->", ";", ":", ", ", "=", "<", ">", ">", "^", "|", "&", "+", "-", "*", "/", "%", "~", "!", "."]

-- Operatori che possono stare a sinistra di un pattern
patLeftOps = ["and", "or", "not", "=", "%=", "~=", "/=", "-=", "+=", "|=", "&=", ">>=", "<<=", "*=", "&&=", "||=", "**=", "||", "&&", "<=>", "==", "===", "!=", "=~", "!~"]

flatEndl :: [Token] -> [Token]
flatEndl []     = []
flatEndl (TOp "\n":TOp "\n":ts) = flatEndl (TOp "\n":ts)
flatEndl (c:cs) = c : flatEndl cs

isCharVariable :: Char -> Bool
isCharVariable c = isAlphaNum c || c == '_'

firstToken :: [Token] -> Token
firstToken ts =
  case safehead ts of
    Just t  -> t
    Nothing -> TVoid

firstChar :: String -> Char
firstChar cs = 
  case safehead cs of
    Just c  -> c
    Nothing -> '\0'

isKeyword :: Token -> Bool
isKeyword (TKeyword _) = True
isKeyword _            = False

-- Ottiene la stringa terminante con il carattere separatore specificato
getCodeString :: Char -> String -> (String, String)
getCodeString _   "" = ("", "")
getCodeString sep ('\\':c:cs) = ('\\':c:s, cs')
  where
    (s, cs') = getCodeString sep cs
getCodeString sep (c:cs) | c == sep = ("", cs)
                         | otherwise = (c:s, cs')
  where
    (s, cs') = getCodeString sep cs

getOperator :: String -> (String, String)
getOperator cs = (op, drop (length op) cs)
  where
    op = extractOperator operators
    
    extractOperator []                            = lexerError cs
    extractOperator (op:ops) | op `isPrefixOf` cs = op
                             | otherwise          = extractOperator ops

{-
 - Lexer
 -}

-- bug: se il commento è in cima rimane l'endl!
fusionLexer :: String -> [Token]
fusionLexer = flatEndl . lexer . enderize

lexerError :: String -> a
lexerError cs = error ("Grammar error: " ++ take 10 cs ++ "...")

lexer :: String -> [Token]
lexer [] = []

lexer (' ':cs) = 
  case firstToken tokens of
  TOp _         -> tokens
  TClose _      -> tokens
  TKeyword _    -> tokens
  TSubKeyword _ -> tokens
  otherwise     -> TOp " " : tokens
  where
    tokens = lexer $ stripLeft cs

lexer ('\n':cs) = 
  case firstToken tokens of
    TSubKeyword _ -> tokens
    TClose _      -> tokens
    otherwise     -> TOp "\n" : tokens
  where
    tokens = lexer $ stripLeft cs

lexer (c:cs) | isAlpha c = lexerWord (c:cs)
             | isDigit c = lexerNum (c:cs)

lexer ('(':cs) = TOpen '(' : lexer (trimLeft cs)
lexer ('[':cs) = TOpen '[' : lexer (trimLeft cs)
lexer ('{':cs) = TOpen '{' : lexer (trimLeft cs)
lexer (')':cs) = TClose ')' : lexer cs
lexer (']':cs) = TClose ']' : lexer cs
lexer ('}':cs) = TClose '}' : lexer cs

lexer ('"':cs) = TString s : lexer cs'
  where
    (s, cs') = getCodeString '"' cs

lexer (',':cs) = TOp "," : lexer (trimLeft cs)
lexer (';':cs) = TOp ";" : lexer (trimLeft cs)

lexer (':':cs@(c:_)) | isCharVariable c = TSymbol name : lexer cs'
  where
    (name, cs') = span isCharVariable cs

lexer cs@('@':_) | n == 1    = TAttr name   : lexer cs''
                 | n == 2    = TStatic name : lexer cs''
                 | otherwise = lexerError cs
  where
    n = length ets
    (ets, cs')   = span ('@'==) cs
    (name, cs'') = span isCharVariable cs'

lexer ('#':cs) = lexer cs'
  where
    (_, cs') = span (not . isEndl) cs

lexer cs = TOp op : cs'
  where
    (op, rest) = getOperator cs
    rest' = trimLeft rest
    
    cs' | op `elem` patLeftOps && 
          firstChar rest' == '/'        = TPattern pat : lexer r
        | isKeyword $ firstToken tokens = lexer $ stripLeft rest
        | otherwise                     = tokens
      where
        (pat, r) = getCodeString '/' $ tail rest'
        tokens = lexer rest'

{- Specific lexers -}

lexerNum cs = TInt (read num) : lexer cs'
  where 
    (num, cs') = span isDigit cs

lexerWord cs = token : lexer cs'
  where
    (word, rest) = span isCharVariable cs
    (token, cs') | word `elem` mainKeywords = (TKeyword word,    stripLeft rest)
                 | word `elem` subKeywords  = (TSubKeyword word, stripLeft rest)
                 | otherwise                = (token, rest)
      where
        token | isUpperString word  = TConst word
              | isUpper $ head word = TClass word
              | otherwise           = TVar word